(*
 *  MTASC - MotionTwin ActionScript2 Compiler
 *  Copyright (c)2004 Nicolas Cannasse
 *
 *  This program is free software; you can redistribute it and/or modify
 *  it under the terms of the GNU General Public License as published by
 *  the Free Software Foundation; either version 2 of the License, or
 *  (at your option) any later version.
 *
 *  This program is distributed in the hope that it will be useful,
 *  but WITHOUT ANY WARRANTY; without even the implied warranty of
 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 *  GNU General Public License for more details.
 *
 *  You should have received a copy of the GNU General Public License
 *  along with this program; if not, write to the Free Software
 *  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 *)
open Expr
open ParserInc
    
let rec parse_code (__strm : _ Stream.t) =
  match Stream.peek __strm with
  | Some ((Eof, _)) -> (Stream.junk __strm; [])
  | Some ((Next, _)) ->
      (Stream.junk __strm;
       (try parse_code __strm
        with | Stream.Failure -> raise (Stream.Error "")))
  | _ ->
      let e = parse_signature __strm in
      let el =
        (try parse_code __strm
         with | Stream.Failure -> raise (Stream.Error ""))
      in e :: el
and parse_signature (__strm : _ Stream.t) =
  match Stream.peek __strm with
  | Some ((BkOpen, _)) ->
      (Stream.junk __strm;
       let _ =
         (try parse_metadata __strm
          with | Stream.Failure -> raise (Stream.Error ""))
       in
         (try parse_signature __strm
          with | Stream.Failure -> raise (Stream.Error "")))
  | Some ((Kwd Import, p1)) ->
      (Stream.junk __strm;
       let (p, w) =
         (try parse_import __strm
          with | Stream.Failure -> raise (Stream.Error ""))
       in ((EImport (p, w)), p1))
  | Some ((Kwd Interface, p1)) ->
      (Stream.junk __strm;
       let path =
         (try parse_class_path __strm
          with | Stream.Failure -> raise (Stream.Error "")) in
       let herits =
         (try parse_herits __strm
          with | Stream.Failure -> raise (Stream.Error ""))
       in
         (match Stream.peek __strm with
          | Some ((BrOpen, p)) ->
              (Stream.junk __strm;
               let (el, p2) =
                 (try parse_class true __strm
                  with | Stream.Failure -> raise (Stream.Error ""))
               in
                 ((EInterface (path, herits, ((EBlock el), (punion p p2)))),
                  (punion p1 p2)))
          | _ -> raise (Stream.Error "")))
  | _ ->
      (match try Some (parse_class_flags __strm)
             with | Stream.Failure -> None
       with
       | Some flags ->
           (match Stream.peek __strm with
            | Some ((Kwd Class, p)) ->
                (Stream.junk __strm;
                 let path =
                   (try parse_class_path __strm
                    with | Stream.Failure -> raise (Stream.Error "")) in
                 let herits =
                   (try parse_herits __strm
                    with | Stream.Failure -> raise (Stream.Error ""))
                 in
                   (match Stream.peek __strm with
                    | Some ((BrOpen, op)) ->
                        (Stream.junk __strm;
                         let s = __strm in
                         let (el, p2) =
                           parse_class (List.exists (( = ) HIntrinsic) flags)
                             s
                         in
                           ((EClass (path, flags @ herits,
                               ((EBlock el), (punion op p2)))),
                            (punion p p2)))
                    | _ -> raise (Stream.Error "")))
            | _ -> raise (Stream.Error ""))
       | _ ->
           let _ = parse_include __strm
           in
             (try parse_signature __strm
              with | Stream.Failure -> raise (Stream.Error "")))
and parse_class interf (__strm : _ Stream.t) =
  match Stream.peek __strm with
  | Some ((BrClose, p)) -> (Stream.junk __strm; ([], p))
  | Some ((Next, _)) ->
      (Stream.junk __strm;
       (try parse_class interf __strm
        with | Stream.Failure -> raise (Stream.Error "")))
  | Some ((BkOpen, _)) ->
      (Stream.junk __strm;
       let _ =
         (try parse_metadata __strm
          with | Stream.Failure -> raise (Stream.Error ""))
       in
         (try parse_class interf __strm
          with | Stream.Failure -> raise (Stream.Error "")))
  | _ ->
      (match try Some (parse_include __strm) with | Stream.Failure -> None
       with
       | Some _ ->
           (try parse_class interf __strm
            with | Stream.Failure -> raise (Stream.Error ""))
       | _ ->
           let flags = parse_field_flags IsMember None __strm in
           let f =
             (try parse_class_field flags interf __strm
              with | Stream.Failure -> raise (Stream.Error "")) in
           let (fl, p) =
             (try parse_class interf __strm
              with | Stream.Failure -> raise (Stream.Error ""))
           in ((f :: fl), p))
and parse_class_field (stat, pub) interf (__strm : _ Stream.t) =
  match Stream.peek __strm with
  | Some ((Kwd Var, p1)) ->
      (Stream.junk __strm;
       let (vl, p2) =
         (try parse_vars parse_eval p1 __strm
          with | Stream.Failure -> raise (Stream.Error ""))
       in ((EVars (stat, pub, vl)), (punion p1 p2)))
  | Some ((Kwd Function, p1)) ->
      (Stream.junk __strm;
       let (name, g) =
         (try parse_fun_name __strm
          with | Stream.Failure -> raise (Stream.Error ""))
       in
         (match Stream.peek __strm with
          | Some ((POpen, _)) ->
              (Stream.junk __strm;
               let (args, p2) =
                 (try parse_args __strm
                  with | Stream.Failure -> raise (Stream.Error "")) in
               let t =
                 (try parse_type_option __strm
                  with | Stream.Failure -> raise (Stream.Error "")) in
               let s = __strm
               in
                 ((EFunction
                     {
                       fname = name;
                       fargs = args;
                       ftype = t;
                       fstatic = stat;
                       fpublic = pub;
                       fgetter = g;
                       fexpr = if interf then None else Some (parse_expr s);
                     }),
                  (punion p1 p2)))
          | _ -> raise (Stream.Error "")))
  | _ -> raise Stream.Failure
and parse_expr (__strm : _ Stream.t) =
  match Stream.peek __strm with
  | Some ((BrOpen, p1)) ->
      (Stream.junk __strm;
       let (el, p2) =
         (try parse_block parse_expr p1 __strm
          with | Stream.Failure -> raise (Stream.Error ""))
       in ((EBlock el), (punion p1 p2)))
  | Some ((Kwd For, p)) ->
      (Stream.junk __strm;
       (match Stream.peek __strm with
        | Some ((POpen, _)) ->
            (Stream.junk __strm;
             let c =
               (try parse_expr_opt parse_expr __strm
                with | Stream.Failure -> raise (Stream.Error ""))
             in
               (try parse_for p c __strm
                with | Stream.Failure -> raise (Stream.Error "")))
        | _ -> raise (Stream.Error "")))
  | Some ((Kwd If, p)) ->
      (Stream.junk __strm;
       let cond =
         (try parse_eval __strm
          with | Stream.Failure -> raise (Stream.Error "")) in
       let e =
         (try parse_expr_opt parse_expr __strm
          with | Stream.Failure -> raise (Stream.Error "")) in
       let (e2, p2) =
         (try parse_else parse_expr (pos e) __strm
          with | Stream.Failure -> raise (Stream.Error ""))
       in ((EIf (cond, wrap_var e, e2)), (punion p p2)))
  | Some ((Kwd Return, p)) ->
      (Stream.junk __strm;
       let (v, p2) =
         (try parse_eval_option parse_eval p __strm
          with | Stream.Failure -> raise (Stream.Error ""))
       in ((EReturn v), (punion p p2)))
  | Some ((Kwd Break, p)) -> (Stream.junk __strm; (EBreak, p))
  | Some ((Kwd Continue, p)) -> (Stream.junk __strm; (EContinue, p))
  | Some ((Kwd While, p1)) ->
      (Stream.junk __strm;
       let v =
         (try parse_eval __strm
          with | Stream.Failure -> raise (Stream.Error "")) in
       let e =
         (try parse_expr_opt parse_expr __strm
          with | Stream.Failure -> raise (Stream.Error ""))
       in ((EWhile (v, wrap_var e, NormalWhile)), (punion p1 (pos e))))
  | Some ((Kwd Do, p1)) ->
      (Stream.junk __strm;
       let e =
         (try parse_expr __strm
          with | Stream.Failure -> raise (Stream.Error ""))
       in
         (match Stream.peek __strm with
          | Some ((Kwd While, _)) ->
              (Stream.junk __strm;
               let v =
                 (try parse_eval __strm
                  with | Stream.Failure -> raise (Stream.Error ""))
               in ((EWhile (v, wrap_var e, DoWhile)), (punion p1 (pos v))))
          | _ -> raise (Stream.Error "")))
  | Some ((Kwd Switch, p1)) ->
      (Stream.junk __strm;
       let v =
         (try parse_eval __strm
          with | Stream.Failure -> raise (Stream.Error ""))
       in
         (match Stream.peek __strm with
          | Some ((BrOpen, _)) ->
              (Stream.junk __strm;
               let (el, p2) =
                 (try parse_switch false __strm
                  with | Stream.Failure -> raise (Stream.Error ""))
               in ((ESwitch (v, el)), (punion p1 p2)))
          | _ -> raise (Stream.Error "")))
  | Some ((Kwd Var, p1)) ->
      (Stream.junk __strm;
       let (vl, p2) =
         (try parse_vars parse_eval p1 __strm
          with | Stream.Failure -> raise (Stream.Error ""))
       in ((EVars (IsMember, IsPublic, vl)), (punion p1 p2)))
  | Some ((Kwd Try, p1)) ->
      (Stream.junk __strm;
       let e =
         (try parse_expr __strm
          with | Stream.Failure -> raise (Stream.Error "")) in
       let c =
         (try parse_catches __strm
          with | Stream.Failure -> raise (Stream.Error "")) in
       let f =
         (try parse_finally parse_expr __strm
          with | Stream.Failure -> raise (Stream.Error ""))
       in ((ETry (wrap_var e, ref c, f)), (punion p1 (pos e))))
  | Some ((Kwd With, p1)) ->
      (Stream.junk __strm;
       let v =
         (try parse_eval __strm
          with | Stream.Failure -> raise (Stream.Error "")) in
       let e =
         (try parse_expr __strm
          with | Stream.Failure -> raise (Stream.Error ""))
       in ((EWith (v, wrap_var e)), (punion p1 (pos e))))
  | _ ->
      (match try Some (parse_eval __strm) with | Stream.Failure -> None with
       | Some e -> ((EVal e), (pos e))
       | _ ->
           let _ = parse_include __strm
           in
             (try parse_expr __strm
              with | Stream.Failure -> raise (Stream.Error "")))
and parse_eval (__strm : _ Stream.t) =
  match Stream.peek __strm with
  | Some ((Kwd Function, p1)) ->
      (Stream.junk __strm;
       (match Stream.peek __strm with
        | Some ((POpen, _)) ->
            (Stream.junk __strm;
             let (args, _) =
               (try parse_args __strm
                with | Stream.Failure -> raise (Stream.Error "")) in
             let t =
               (try parse_type_option __strm
                with | Stream.Failure -> raise (Stream.Error "")) in
             let e =
               (try parse_expr __strm
                with | Stream.Failure -> raise (Stream.Error ""))
             in
               (try
                  parse_eval_next parse_eval
                    ((ELambda
                        {
                          fname = "";
                          fargs = args;
                          ftype = t;
                          fgetter = Normal;
                          fstatic = IsStatic;
                          fpublic = IsPublic;
                          fexpr = Some e;
                        }),
                     (punion p1 (pos e)))
                    __strm
                with | Stream.Failure -> raise (Stream.Error "")))
        | _ -> raise (Stream.Error "")))
  | Some ((Kwd Throw, p1)) ->
      (Stream.junk __strm;
       (try parse_delete ((EConst (Ident "throw")), p1) __strm
        with | Stream.Failure -> raise (Stream.Error "")))
  | Some ((Kwd Delete, p1)) ->
      (Stream.junk __strm;
       (try parse_delete ((EConst (Ident "delete")), p1) __strm
        with | Stream.Failure -> raise (Stream.Error "")))
  | Some ((Kwd Typeof, p1)) ->
      (Stream.junk __strm;
       (try parse_delete ((EConst (Ident "typeof")), p1) __strm
        with | Stream.Failure -> raise (Stream.Error "")))
  | Some ((Kwd New, p1)) ->
      (Stream.junk __strm;
       let (v, p2) =
         (try parse_eval __strm
          with | Stream.Failure -> raise (Stream.Error "")) in
       let s = __strm
       in
         (match v with
          | ECall (v, args) ->
              parse_eval_next parse_eval ((ENew (v, args)), (punion p1 p2)) s
          | _ -> parse_eval_next parse_eval ((ENew ((v, p2), [])), (punion p1 p2)) s))
  | Some ((Const c, p)) ->
      (Stream.junk __strm;
       (try parse_eval_next parse_eval ((EConst c), p) __strm
        with | Stream.Failure -> raise (Stream.Error "")))
  | Some ((Kwd This, p)) ->
      (Stream.junk __strm;
       (try parse_eval_next parse_eval ((EConst (Ident "this")), p) __strm
        with | Stream.Failure -> raise (Stream.Error "")))
  | Some ((POpen, p1)) ->
      (Stream.junk __strm;
       let e =
         (try parse_eval __strm
          with | Stream.Failure -> raise (Stream.Error ""))
       in
         (match Stream.peek __strm with
          | Some ((PClose, p2)) ->
              (Stream.junk __strm;
               (try parse_eval_next parse_eval ((EParenthesis e), (punion p1 p2)) __strm
                with | Stream.Failure -> raise (Stream.Error "")))
          | _ -> raise (Stream.Error "")))
  | Some ((BrOpen, p1)) ->
      (Stream.junk __strm;
       let (el, p2) =
         (try parse_field_list parse_eval __strm
          with | Stream.Failure -> raise (Stream.Error ""))
       in
         (try parse_eval_next parse_eval ((EObjDecl el), (punion p1 p2)) __strm
          with | Stream.Failure -> raise (Stream.Error "")))
  | Some ((BkOpen, p1)) ->
      (Stream.junk __strm;
       let (el, p2) =
         (try parse_array parse_eval __strm
          with | Stream.Failure -> raise (Stream.Error ""))
       in
         (try parse_eval_next parse_eval ((EArrayDecl el), (punion p1 p2)) __strm
          with | Stream.Failure -> raise (Stream.Error "")))
  | Some ((Unop op, p1)) when is_prefix op ->
      (Stream.junk __strm;
       let e =
         (try parse_eval __strm
          with | Stream.Failure -> raise (Stream.Error ""))
       in make_unop op e p1)
  | Some ((Binop OpSub, p1)) ->
      (Stream.junk __strm;
       let e =
         (try parse_eval __strm
          with | Stream.Failure -> raise (Stream.Error ""))
       in make_unop Neg e p1)
  | _ ->
      let _ = parse_include __strm
      in
        (try parse_eval_next parse_eval ((EObjDecl []), null_pos) __strm
         with | Stream.Failure -> raise (Stream.Error ""))
and parse_delete v (__strm : _ Stream.t) =
  match try Some (parse_eval __strm) with | Stream.Failure -> None with
  | Some e ->
      let s = __strm in
      let rec loop =
        (function
         | (EBinop (op, e1, e2), _) ->
             ((EBinop (op, loop e1, e2)), (punion (pos e) (pos v)))
         | e -> ((ECall (v, [ e ])), (punion (pos e) (pos v))))
      in parse_eval_next parse_eval (loop e) s
  | _ -> parse_eval_next parse_eval v __strm
and parse_catches (__strm : _ Stream.t) =
  match Stream.peek __strm with
  | Some ((Kwd Catch, _)) ->
      (Stream.junk __strm;
       (match Stream.peek __strm with
        | Some ((POpen, _)) ->
            (Stream.junk __strm;
             (match Stream.peek __strm with
              | Some ((Const (Ident name), _)) ->
                  (Stream.junk __strm;
                   let t =
                     (try parse_type_option __strm
                      with | Stream.Failure -> raise (Stream.Error ""))
                   in
                     (match Stream.peek __strm with
                      | Some ((PClose, _)) ->
                          (Stream.junk __strm;
                           let e =
                             (try parse_expr __strm
                              with
                              | Stream.Failure -> raise (Stream.Error "")) in
                           let l =
                             (try parse_catches __strm
                              with
                              | Stream.Failure -> raise (Stream.Error ""))
                           in (name, t, e) :: l)
                      | _ -> raise (Stream.Error "")))
              | _ -> raise (Stream.Error "")))
        | _ -> raise (Stream.Error "")))
  | _ -> []

and parse_switch def (__strm : _ Stream.t) =
  match Stream.peek __strm with
  | Some ((BrClose, p)) -> (Stream.junk __strm; ([], p))
  | Some ((Kwd Case, p)) ->
      (Stream.junk __strm;
       let v =
         (try parse_eval __strm
          with | Stream.Failure -> raise (Stream.Error ""))
       in
         (match Stream.peek __strm with
          | Some ((DblDot, _)) ->
              (Stream.junk __strm;
               let c =
                 (try parse_switch_clause parse_expr __strm
                  with | Stream.Failure -> raise (Stream.Error "")) in
               let (el, p2) =
                 (try parse_switch def __strm
                  with | Stream.Failure -> raise (Stream.Error ""))
               in ((((Some v), ((EBlock c), p)) :: el), p2))
          | _ -> raise (Stream.Error "")))
  | Some ((Kwd Default, p)) ->
      (Stream.junk __strm;
       (match Stream.peek __strm with
        | Some ((DblDot, _)) ->
            (Stream.junk __strm;
             let c =
               (try parse_switch_clause parse_expr __strm
                with | Stream.Failure -> raise (Stream.Error "")) in
             let (el, p2) =
               (try parse_switch true __strm
                with | Stream.Failure -> raise (Stream.Error ""))
             in
               (if def then error Duplicate_default p else ();
                (((None, ((EBlock c), p)) :: el), p2)))
        | _ -> raise (Stream.Error "")))
  | _ -> raise Stream.Failure  
  
and parse_for p c (__strm : _ Stream.t) =
  match Stream.peek __strm with
  | Some ((Kwd In, _)) ->
      (Stream.junk __strm;
       let v =
         (try parse_eval __strm
          with | Stream.Failure -> raise (Stream.Error ""))
       in
         (match Stream.peek __strm with
          | Some ((PClose, p2)) ->
              (Stream.junk __strm;
               let e =
                 (try parse_expr_opt parse_expr __strm
                  with | Stream.Failure -> raise (Stream.Error ""))
               in ((EForIn (c, v, wrap_var e)), (punion p p2)))
          | _ -> raise (Stream.Error "")))
  | _ ->
      let cl = parse_for_conds parse_expr __strm in
      let l1 =
        (try parse_eval_list parse_eval __strm
         with | Stream.Failure -> raise (Stream.Error "")) in
      let l2 =
        (try parse_eval_list parse_eval __strm
         with | Stream.Failure -> raise (Stream.Error ""))
      in
        (match Stream.peek __strm with
         | Some ((PClose, p2)) ->
             (Stream.junk __strm;
              let e =
                (try parse_expr_opt parse_expr __strm
                 with | Stream.Failure -> raise (Stream.Error ""))
              in ((EFor (c :: cl, l1, l2, wrap_var e)), (punion p p2)))
         | _ -> raise (Stream.Error ""))

let parse code file =
  let old = Lexer.save ()
  in
    (Lexer.init file;
     let last = ref (Eof, null_pos) in
     let comments = ref [] in
     let rec next_token x =
       let (t, p) = Lexer.token code
       in
         match t with
         | Comment s | CommentLine s ->
             (last_comment := Some s;
              comments := (s, p) :: !comments;
              next_token x)
         | _ -> (last := (t, p); Some (t, p))
     in
       try
         let l = parse_code (Stream.from next_token)
         in (Lexer.restore old; (l, (List.rev !comments)))
       with
       | Stream.Error _ | Stream.Failure ->
           (Lexer.restore old; error (Unexpected (fst !last)) (pos !last))
       | e -> (Lexer.restore old; raise e))
  

